VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsApproveFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private strBlah As String
Public Function ValidateXmlFormat(strErrMsg As String) As Boolean

    Dim xmldoc As MSXML2.DOMDocument
    Dim strXML As String

    On Error GoTo ValidateXmlFormatFix

    Set xmldoc = New MSXML2.DOMDocument
    strXML = IdxVars.XmlString
    
    'Validation XML Document
    'i.e. load the source XML file into an MSXML DOMDocument object
    xmldoc.async = False
    'If Not XMLDoc.Load("C:\Projects\KeyTax\Xml\XmlDocs\FormB_Request.xml") Then
    If Not xmldoc.loadXML(strXML) Then
        xmldoc.validateOnParse = True
        strErrMsg = strErrMsg & "Error Code:" & xmldoc.parseError.errorCode & vbCrLf
        strErrMsg = strErrMsg & "Error Reason:" & xmldoc.parseError.reason & vbCrLf
        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.srcText & vbCrLf
        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.Line & vbCrLf
        
        ValidateXmlFormat = False
    Else
        ValidateXmlFormat = True
    End If

    Exit Function
    
ValidateXmlFormatFix:
    WriteToErr "ValidateXmlFormat: " & Err.Number & " - " & Err.Description
    ValidateXmlFormat = False
End Function

Public Function ExtractIndexBlobFromDb(lngInterfaceNo As Long) As Boolean


    Dim rsBlob As ADODB.Recordset
     Dim arrBlob() As Byte
     Dim iFree As Integer
     Dim lngBlobLen As Long
     Dim lngRemainder As Long
     Dim lngNumOfSections As Long
     Dim strSql As String
     Dim BlobHolder As Variant
     Dim i As Integer
     Dim strHolder As String

     Const SEGMENT_LENGTH As Long = 4096

    On Error GoTo ExtractIndexBlobFromDbFix

     iFree = FreeFile
     'initilize the recordset
     Set rsBlob = New ADODB.Recordset
     rsBlob.CursorType = adOpenKeyset
     rsBlob.LockType = adLockOptimistic
     
    strSql = "Select * from DIR_INTERFACE_INDEX I, DIR_INTERFACE_XML X"
    strSql = strSql & " where I.INTERFACE_NO = X.INTERFACE_NO"
    strSql = strSql & " and I.INTERFACE_NO = " & lngInterfaceNo
    strSql = strSql & " and MQ_STATUS = '04'" 'Processed - changed to this by Receive XML
    Set rsBlob = adoConn.Execute(strSql)
     
     
     If rsBlob.BOF = True And rsBlob.EOF = True Then
         MsgBox "Nothing to process"
         ExtractIndexBlobFromDb = False
         Exit Function
    Else
        ExtractIndexBlobFromDb = True
     End If
     rsBlob.MoveFirst
     
     'barb: get idx vars here
     IdxVars.InterfaceNo = lngInterfaceNo
     IdxVars.Tracking.MsgId = NullOrValue(rsBlob!MESSAGE_ID)
     IdxVars.Tracking.ComId = NullOrValue(rsBlob!COM_ID)
     IdxVars.Tracking.BuId = NullOrValue(rsBlob!BU_ID)
     IdxVars.Tracking.ReferenceId = NullOrValue(rsBlob!REFERENCE_ID)
     IdxVars.Tracking.ReqSeqNum = NullOrValue(rsBlob!REQ_SEQ_NUM)
     IdxVars.KeyTaxType = NullOrValue(rsBlob!KEYTAX_TYPE)
     IdxVars.MqStatus = NullOrValue(rsBlob!MQ_STATUS)
     IdxVars.CreatedDated = NullOrValue(rsBlob!CREATED_DATE)
     IdxVars.Tracking.ReqSeqNum = NullOrValue(rsBlob!REQ_SEQ_NUM)

     'get the length of the blob
     lngBlobLen = rsBlob!XML_STRING.ActualSize

     'get the number of sections that will be the number of elements in the sections array
     lngNumOfSections = lngBlobLen \ SEGMENT_LENGTH

     'get the leftover bytes that aren't divisible by the section_length
     lngRemainder = lngBlobLen Mod SEGMENT_LENGTH

     If lngRemainder <> 0 Then 'add the remaider
         'arrBlob = rsBlob(2).GetChunk(lngRemainder)
         arrBlob = rsBlob!XML_STRING.GetChunk(lngRemainder)
     End If

    strHolder = CStr(arrBlob)

    'loop for the rest
    For i = 1 To lngNumOfSections
        'arrBlob = rsBlob(0).GetChunk(SEGMENT_LENGTH)
        arrBlob = rsBlob!XML_STRING.GetChunk(SEGMENT_LENGTH)
        'strTemp = strTemp & CStr(arrBlob(i - 1))
        strHolder = strHolder & CStr(arrBlob)
    Next

'     For i = 0 To UBound(arrBlob)
'         strHolder = strHolder & Chr(arrBlob(i))
'     Next

'     strXmlString = strHolder
     IdxVars.XmlString = strHolder
    

     rsBlob.Close

    Exit Function
ExtractIndexBlobFromDbFix:
    ExtractIndexBlobFromDb = False
    WriteToErr "ExtractIndexBlobFromDb: " & Err.Number & " - " & Err.Description
End Function
    
Public Function GetHeaderData() As Boolean
    
    '   This function reads the xml string and extracts the values required to update and insert into the
    '   DIR_INTERFACE_INDEX table and puts them into the public IdxVars type
    
    'XML Objects
    Dim xmldoc As MSXML2.DOMDocument
    Dim nlKeytax As MSXML2.IXMLDOMNodeList
    Dim elKeyTax As MSXML2.IXMLDOMElement
    Dim nlTracking As MSXML2.IXMLDOMNodeList
    Dim elTracking As MSXML2.IXMLDOMElement
 
    'Other
    Dim i As Integer
    Dim strErrMsg As String
    Dim strXmlString As String

    On Error GoTo GetHeaderDataFix
    
    Set xmldoc = New MSXML2.DOMDocument
    'Get Data
    'XMLDoc.Load ("C:\Shane\Projects\LCB\FormB\FormB_Request.xml")
    xmldoc.loadXML (IdxVars.XmlString)
    
    Set nlKeytax = xmldoc.selectNodes("/KeyTax")
    Set elKeyTax = nlKeytax.Item(0)
    'IdxVars.KeyTaxType = elKeyTax.getAttribute("Type")
    IdxVars.KeyTaxType = "06"               'File Approved
    
    Set nlTracking = xmldoc.selectNodes("/KeyTax/Requestor/*")

    For i = 0 To nlTracking.length - 1
        Set elTracking = nlTracking.Item(i)
        Select Case elTracking.nodeName
                Case "Date"
                    IdxVars.Request.Date = NullOrValue(nlTracking.Item(i).nodeTypedValue)
                Case "Time"
                    IdxVars.Request.Time = NullOrValue(nlTracking.Item(i).nodeTypedValue)
                Case "Name"
                    IdxVars.Request.Name = NullOrValue(nlTracking.Item(i).nodeTypedValue)
                Case "UserID"
                    IdxVars.Request.UserId = NullOrValue(nlTracking.Item(i).nodeTypedValue)
                Case "email"
                    IdxVars.Request.Email = NullOrValue(nlTracking.Item(i).nodeTypedValue)
        End Select
    Next i
    
    
    Set nlTracking = xmldoc.selectNodes("/KeyTax/Tracking/*")

    For i = 0 To nlTracking.length - 1
        Set elTracking = nlTracking.Item(i)
        Select Case elTracking.nodeName
                Case "RequestStatus"
                    If Len(Trim(IdxVars.Tracking.RequestStatus)) = 0 Then
                        IdxVars.Tracking.RequestStatus = NullOrValue(nlTracking.Item(i).nodeTypedValue)
                    End If
                Case "Company"
                    If Len(Trim(IdxVars.Tracking.ComId)) = 0 Then
                        IdxVars.Tracking.ComId = NullOrValue(elTracking.getAttribute("ID"))
                    End If
                Case "BusinessUnit"
                    If Len(Trim(IdxVars.Tracking.BuId)) = 0 Then
                        IdxVars.Tracking.BuId = NullOrValue(elTracking.getAttribute("ID"))
                    End If
                Case "Message"
                    If Len(Trim(IdxVars.Tracking.MsgId)) = 0 Then
                        IdxVars.Tracking.MsgId = NullOrValue(elTracking.getAttribute("ID"))
                    End If
                Case "Reference"
                    If Len(Trim(IdxVars.Tracking.ReferenceId)) = 0 Then
                        IdxVars.Tracking.ReferenceId = NullOrValue(elTracking.getAttribute("ID"))
                    End If
                Case "KeytaxRequestNumber"
                    If Len(Trim(IdxVars.Tracking.ReqSeqNum)) = 0 Then
                        IdxVars.Tracking.ReqSeqNum = NullOrValue(nlTracking.Item(i).nodeTypedValue)
                    End If

        End Select
    Next i

    

    GetHeaderData = True

Exit Function

GetHeaderDataFix:
    GetHeaderData = False
    WriteToErr "GetHeaderData: " & Err.Number & " - " & Err.Description
End Function

Private Function NullOrValue(varValue As Variant) As String

    If Not IsNull(varValue) Then
        If Len(Trim(varValue)) <> 0 Then
           NullOrValue = Trim(varValue)
        Else
            NullOrValue = "NULL"
        End If
    Else
        NullOrValue = "NULL"
    End If

End Function
Public Function ValidateHeaderData(strErr As String) As Boolean
    
    Dim strSql As String
    Dim rsIndex As ADODB.Recordset

    Dim arBusUnits As Variant
    Dim blnFound As Boolean
    Dim strBusUnit As String
    Dim strFileBusUnit As String
    Dim i As Integer
    Dim j As Integer

    On Error GoTo ValidateHeaderDataFix


'     'initilize the recordset
     Set rsIndex = New ADODB.Recordset
     rsIndex.CursorType = adOpenKeyset
     rsIndex.LockType = adLockOptimistic

    '***************Index Vars****************
    'InterfaceNo
    If IdxVars.InterfaceNo = 0 Then
        strErr = strErr & "Invalid Interface number: " & IdxVars.InterfaceNo & vbCrLf
    ElseIf Len(Trim(IdxVars.InterfaceNo)) = 0 Then
        strErr = strErr & "Invalid Interface number: " & IdxVars.InterfaceNo & vbCrLf
    End If
             
     'xml string
    If Len(Trim(IdxVars.XmlString)) = 0 Then
        strErr = strErr & "Invalid XML string: " & IdxVars.XmlString & vbCrLf
    End If

    'CreatedDate
    If Len(Trim(IdxVars.CreatedDated)) = 0 Then
        strErr = strErr & "Invalid CreatedDated: " & IdxVars.CreatedDated & vbCrLf
    ElseIf Trim(IdxVars.CreatedDated) = "NULL" Then
        strErr = strErr & "Invalid CreatedDated: " & IdxVars.CreatedDated & vbCrLf
    End If
'   IsDate doesn't work with "YYYYMMDD"
'    If Not IsDate(IdxVars.CreatedDated) Then
'        strErr = strErr & "Invalid CreatedDated: " & IdxVars.CreatedDated & vbCrLf
'    End If
    
    'IdxVars.SarsResponseYn = ""        'Allowed to be empty
    
    'KeyTaxType (DIR_SYSTEM_CODES.XML_TYPE)
    If Len(Trim(IdxVars.KeyTaxType)) = 0 Then
        strErr = strErr & "Invalid KeyTaxType: " & IdxVars.KeyTaxType & vbCrLf
    ElseIf Trim(IdxVars.KeyTaxType) = "NULL" Then
        strErr = strErr & "Invalid KeyTaxType: " & IdxVars.KeyTaxType & vbCrLf
    Else
        strSql = "select VALUE from DIR_SYSTEM_CODES where CODE = 'XML_TYPE' and VALUE = '" & IdxVars.KeyTaxType & "'"
        Set rsIndex = adoConn.Execute(strSql)
        If rsIndex.RecordCount <= 0 Then
            strErr = strErr & "Invalid KeyTaxType (DIR_SYSTEM_CODES.XML_TYPE): " & IdxVars.KeyTaxType & vbCrLf
        End If
    End If
    
    'MqStatus (DIR_SYSTEM_CODES.MQ_STATUS)
    If Len(Trim(IdxVars.MqStatus)) = 0 Then
        strErr = strErr & "Invalid MqStatus: " & IdxVars.KeyTaxType & vbCrLf
    ElseIf Trim(IdxVars.MqStatus) = "NULL" Then
        strErr = strErr & "Invalid MqStatus: " & IdxVars.KeyTaxType & vbCrLf
    Else
        strSql = "select VALUE from DIR_SYSTEM_CODES where CODE = 'MQ_STATUS' and VALUE = '" & IdxVars.MqStatus & "'"
        Set rsIndex = adoConn.Execute(strSql)
        If rsIndex.RecordCount <= 0 Then
            strErr = strErr & "Invalid MqStatus (DIR_SYSTEM_CODES.MQ_STATUS): " & IdxVars.MqStatus & vbCrLf
        End If
    End If
    '*************Tracking Vars*****************
    'MsgId
    If Len(Trim(IdxVars.Tracking.MsgId)) = 0 Then
        strErr = strErr & "Invalid MsgId: " & IdxVars.Tracking.MsgId & vbCrLf
    ElseIf Trim(IdxVars.Tracking.MsgId) = "NULL" Then
        strErr = strErr & "Invalid MsgId: " & IdxVars.Tracking.MsgId & vbCrLf
    End If
    
    'ComId  (DIR_COMPANIES.COM_ID)
    If Len(Trim(IdxVars.Tracking.ComId)) = 0 Then
        strErr = strErr & "Invalid ComId: " & IdxVars.Tracking.ComId & vbCrLf
    ElseIf Trim(IdxVars.Tracking.ComId) = "NULL" Then
        strErr = strErr & "Invalid ComId: " & IdxVars.Tracking.ComId & vbCrLf
    Else
        strSql = "Select COM_ID from DIR_COMPANIES where COM_ID = '" & IdxVars.Tracking.ComId & "'"
        Set rsIndex = adoConn.Execute(strSql)
        If rsIndex.RecordCount <= 0 Then
            strErr = strErr & "Invalid ComId (DIR_COMPANIES.COM_ID): " & IdxVars.Tracking.ComId & vbCrLf
        Else
            If Len(Trim(IdxVars.Tracking.ComId)) <> 2 Then
                IdxVars.Tracking.ComId = Format(IdxVars.Tracking.ComId, "00")
            End If
        End If
    End If
    
    'BusUnit (DIR_BUSINESS_UNITS.CODE)
    If Len(Trim(IdxVars.Tracking.BuId)) = 0 Then
        strErr = strErr & "Invalid BuId: " & IdxVars.Tracking.BuId & vbCrLf
    ElseIf Trim(IdxVars.Tracking.BuId) = "NULL" Then
        strErr = strErr & "Invalid BuId: " & IdxVars.Tracking.BuId & vbCrLf
    Else
        'validate bus unit (LCB also using this field to indicate environment)
        Set rsIndex = New ADODB.Recordset
        rsIndex.CursorType = adOpenKeyset
        rsIndex.LockType = adLockOptimistic
                        
        'strSql = "Select CODE from DIR_BUSINESS_UNITS where COM_ID = '" & IdxVars.Tracking.ComId & "' and CODE = '" & IdxVars.Tracking.BuId & "'"
        strSql = "Select CODE from DIR_BUSINESS_UNITS where COM_ID = '" & IdxVars.Tracking.ComId & "'"
        Set rsIndex = adoConn.Execute(strSql)
        If rsIndex.RecordCount > 0 Then
            arBusUnits = rsIndex.GetRows(rsIndex.RecordCount)
            For i = 0 To UBound(arBusUnits, 2)
                'For j = 1 To Len(Trim(arBusUnits(0, i)))
                For j = 1 To Len(Trim(IdxVars.Tracking.BuId))
                    'strBusUnit = Left(arBusUnits(0, i), j)
                    strFileBusUnit = Left(IdxVars.Tracking.BuId, j)
                    strBusUnit = arBusUnits(0, i)
                    'If IdxVars.Tracking.BuId Like strBusUnit & "*" Then
                    If strFileBusUnit = strBusUnit Then
                        blnFound = True
                        Exit For
                    Else
                        blnFound = False
                    End If
                Next j
                If blnFound = True Then
                    Exit For
                End If
            Next i
            If blnFound = False Then
                strErr = strErr & "Invalid BuId (DIR_BUSINESS_UNITS.CODE): " & IdxVars.Tracking.BuId & vbCrLf
            End If
        Else
            strErr = strErr & "No business units were found in DIR_BUSINESS_UNITS for DIR_BUSINESS_UNITS.COM_ID: " & IdxVars.Tracking.ComId & " (DIR_BUSINESS_UNITS.CODE: " & IdxVars.Tracking.BuId & ")" & vbCrLf
        End If
    End If
    
    
    'ReferenceId
    If Len(Trim(IdxVars.Tracking.ReferenceId)) = 0 Then
        strErr = strErr & "Invalid ReferenceId: " & IdxVars.Tracking.ReferenceId & vbCrLf
    ElseIf Trim(IdxVars.Tracking.ReferenceId) = "NULL" Then
        strErr = strErr & "Invalid ReferenceId: " & IdxVars.Tracking.ReferenceId & vbCrLf
    End If
    
    'ReqSeqNum (DIR_REQUEST.REQ_SEQ_NUM)
    'by now ReqSeqNum is mandatory
    If Len(Trim(IdxVars.Tracking.ReqSeqNum)) = 0 Then
        strErr = strErr & "Invalid ReqSeqNum: " & IdxVars.Tracking.ReqSeqNum & vbCrLf
    ElseIf IdxVars.Tracking.ReqSeqNum = "NULL" Then
        strErr = strErr & "Invalid ReqSeqNum: " & IdxVars.Tracking.ReqSeqNum & vbCrLf
    Else
        strSql = "Select REQ_SEQ_NUM from DIR_REQUEST where REQ_SEQ_NUM = " & IdxVars.Tracking.ReqSeqNum
        Set rsIndex = adoConn.Execute(strSql)
        If rsIndex.RecordCount <= 0 Then
            strErr = strErr & "Invalid ReqSeqNum (DIR_REQUEST.REQ_SEQ_NUM): " & IdxVars.Tracking.ReqSeqNum & vbCrLf
        End If
    End If
    
    'RequestStatus  (DIR_SYSTEM_CODES.DIR_REQ_STATUS)
'    If Len(Trim(IdxVars.Tracking.RequestStatus)) = "" Then
'        strErr = strErr & "Invalid RequestStatus: " & IdxVars.Tracking.RequestStatus & vbCrLf
'    ElseIf Trim(IdxVars.Tracking.RequestStatus) = "NULL" Then
'            strErr = strErr & "Invalid RequestStatus: " & IdxVars.Tracking.RequestStatus & vbCrLf
'    Else
'        strSql = "Select MEANING from DIR_SYSTEM_CODES where CODE = 'DIR_REQ_STATUS' and MEANING = '" & IdxVars.Tracking.RequestStatus & "'"
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid RequestStatus (DIR_SYSTEM_CODES.DIR_REQ_STATUS): " & IdxVars.Tracking.RequestStatus & vbCrLf
'        End If
'    End If
    
    '****************Requestor Vars*********************
    'Date
    If Len(Trim(IdxVars.Request.Date)) = 0 Then
        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
    ElseIf Trim(IdxVars.Request.Date) = "NULL" Then
        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
'   IsDate doesn't work with "YYYYMMDD"?
'    ElseIf Not IsDate(IdxVars.Request.Date) Then
'        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
    ElseIf Len(Trim(IdxVars.Request.Date)) <> 8 Then
        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
    End If
    
    'Email
    If Len(Trim(IdxVars.Request.Email)) = 0 Then
        strErr = strErr & "Invalid Email: " & IdxVars.Request.Email & vbCrLf
    ElseIf Trim(IdxVars.Request.Email) = "NULL" Then
        strErr = strErr & "Invalid Email: " & IdxVars.Request.Email & vbCrLf
    ElseIf InStr(1, IdxVars.Request.Email, "@") = 0 Then
        strErr = strErr & "Invalid Email: " & IdxVars.Request.Email & vbCrLf
    End If
    
    'Name
    If Len(Trim(IdxVars.Request.Name)) = 0 Then
        strErr = strErr & "Invalid Name: " & IdxVars.Request.Name & vbCrLf
    ElseIf Trim(IdxVars.Request.Name) = "NULL" Then
        strErr = strErr & "Invalid Name: " & IdxVars.Request.Name & vbCrLf
    End If
    
    'Time
    If Len(Trim(IdxVars.Request.Time)) = 0 Then
        strErr = strErr & "Invalid Time: " & IdxVars.Request.Time & vbCrLf
    ElseIf Trim(IdxVars.Request.Time) = "NULL" Then
        strErr = strErr & "Invalid Time: " & IdxVars.Request.Time & vbCrLf
    ElseIf Len(Trim(IdxVars.Request.Time)) <> 6 Then
        strErr = strErr & "Invalid Time: " & IdxVars.Request.Time & vbCrLf
    End If
    
    'UserId
    If Len(Trim(IdxVars.Request.UserId)) = 0 Then
        strErr = strErr & "Invalid UserId: " & IdxVars.Request.UserId & vbCrLf
    ElseIf Trim(IdxVars.Request.UserId) = "NULL" Then
        strErr = strErr & "Invalid UserId: " & IdxVars.Request.UserId & vbCrLf
    End If
    
    If Len(Trim(strErr)) = 0 Then
        ValidateHeaderData = True
    Else
        ValidateHeaderData = False
    End If
    
    Exit Function
    
ValidateHeaderDataFix:
    ValidateHeaderData = False
    WriteToErr "ValidateHeaderData: " & Err.Number & " - " & Err.Description
End Function

Public Function UpdateInterfaceIndex(strErrMsg As String) As Boolean

    'barb: if this funcs not used - delete

    'Db vars
    Dim strSql As String
    Dim cmdAdo As ADODB.Command
    Dim lngRecordsAffected As Long
    Dim rsIndex As ADODB.Recordset

    On Error GoTo UpdateInterfaceIndexFix


'     'initilize the recordset
     Set rsIndex = New ADODB.Recordset
     rsIndex.CursorType = adOpenKeyset
     rsIndex.LockType = adLockOptimistic
     
     
'    strSql = "Select * from DIR_INTERFACE_INDEX"
    'strSql = "Select * from DIR_INTERFACE_INDEX"
    'strSql = "Select XML_STRING from DIR_INTERFACE_INDEX I, DIR_INTERFACE_XML X"
    strSql = "Select * from DIR_INTERFACE_INDEX"
    strSql = strSql & " where INTERFACE_NO = " & CLng(IdxVars.InterfaceNo)
    Set rsIndex = adoConn.Execute(strSql)
    If rsIndex.RecordCount = 1 Then
        strSql = "Update DIR_INTERFACE_INDEX"
        'these should already have been inserted by Johan
        'strSql = strSql & " set COM_ID = '" & IdxVars.Tracking.ComId & "'"
        'strSql = strSql & ", BU_ID = '" & IdxVars.Tracking.BuId & "'"
        'strSql = strSql & ", MESSAGE_ID = '" & IdxVars.Tracking.MsgId & "'"
        strSql = strSql & " set REFERENCE_ID = '" & IdxVars.Tracking.ReferenceId & "'"
        If IdxVars.Tracking.ReqSeqNum <> "NULL" Then
            If IdxVars.Tracking.ReqSeqNum <> "" Then
                strSql = strSql & ", REQ_SEQ_NUM = " & IdxVars.Tracking.ReqSeqNum
            End If
        End If
        'strSql = strSql & ", CREATED_DATE = '" & IdxVars.ComId & "'"
        strSql = strSql & ", KEYTAX_TYPE = '" & IdxVars.KeyTaxType & "'"
        'strSql = strSql & ", MQ_STATUS = '" & IdxVars.MqStatus & "'"
        strSql = strSql & ", MQ_STATUS = '04'"  'Processed
        strSql = strSql & " where INTERFACE_NO = " & CLng(IdxVars.InterfaceNo)
        
        Set cmdAdo = New ADODB.Command
        With cmdAdo
            .CommandText = strSql
            .CommandType = adCmdText
            Set .ActiveConnection = adoConn
            .Execute lngRecordsAffected
        End With
        If lngRecordsAffected = 1 Then
            UpdateInterfaceIndex = True
        Else
            UpdateInterfaceIndex = False
        End If
    Else
        UpdateInterfaceIndex = False
    End If
    
    Exit Function

UpdateInterfaceIndexFix:
    UpdateInterfaceIndex = False
    WriteToErr "UpdateInterfaceIndex: " & Err.Number & " - " & Err.Description
End Function

Public Function CreateXmlVersionDtdHeader() As String
    Dim strXmlString As String
    
    strXmlString = "<?xml version=""1.0"" encoding=""UTF-8""?>" & Chr(13)
    strXmlString = strXmlString & "<!DOCTYPE KeyTax SYSTEM """ & App.Path & "\FileApproved.dtd"">" & Chr(13)
    
    CreateXmlVersionDtdHeader = strXmlString
    
End Function
Public Function CreateXmlHeader() As String
    
    Dim xmldoc As MSXML2.DOMDocument
     
    Dim nNode As MSXML2.IXMLDOMNode
    Dim nChild As MSXML2.IXMLDOMNode
    Dim nParentList As MSXML2.IXMLDOMNodeList
    Dim nParentFoundList As MSXML2.IXMLDOMNodeList
    Dim nParent As MSXML2.IXMLDOMNode
    Dim eParent As MSXML2.IXMLDOMElement
    Dim eChild As MSXML2.IXMLDOMElement
    Dim strNewKtMsgId As String
     
    On Error GoTo WriteXmlStringFix
    
    Set xmldoc = New MSXML2.DOMDocument
    
    Set nNode = xmldoc.createNode(NODE_ELEMENT, "KeyTax", "")
    Set xmldoc.documentElement = nNode
     
    Set nParentList = xmldoc.getElementsByTagName("KeyTax")
    'XML_TYPE
    '01 = Directive Request,02=Response,03=Cancel Directive Request,04=Cancel Directive Response,
    '05=Decline Response,06=File Approved Response,07=Resend Directive Request,08=Status Enquiry Request,
    '09=Status Response,10=File Error Response-->
    '<!ATTLIST KeyTax
    'Type CDATA #FIXED "06"
    
    Set eParent = nParentList.Item(0)
    Call eParent.setAttribute("Type", "06")     '06=File Approved Response XML_TYPE - fixed in approve.dtd
     
    'KeyTax node
    'Add 2 children nodes to the parent KeyTax
    Set eParent = nParentList.Item(0)
    Set eChild = xmldoc.createElement("Requestor")
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("Tracking")
    Call eParent.appendChild(eChild)
     
    'MsgBox xmldoc.xml
     
    'Requestor node
    'Set nParentList = xmldoc.selectNodes("/KeyTax/Requestor/*")
    Set nParentList = xmldoc.getElementsByTagName("Requestor")
    Set eParent = nParentList.Item(0)
    Set eChild = xmldoc.createElement("Date")
    eChild.Text = IdxVars.Request.Date
    'Call eChild.setAttribute("Name", "Name Value")
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("Time")
    eChild.Text = IdxVars.Request.Time
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("Name")
    eChild.Text = IdxVars.Request.Name
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("UserID")
    eChild.Text = IdxVars.Request.UserId
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("email")
    eChild.Text = IdxVars.Request.Email
    Call eParent.appendChild(eChild)
     
     
    'MsgBox xmldoc.xml
     
    'Tracking node
    'Set nParentList = xmldoc.selectNodes("/KeyTax/Requestor/*")
    Set nParentList = xmldoc.getElementsByTagName("Tracking")
    Set eParent = nParentList.Item(0)
    Set eChild = xmldoc.createElement("RequestStatus")
    eChild.Text = IdxVars.Tracking.RequestStatus
    '15 - fixed for error.dtd
    'Call eChild.setAttribute("Type", "14")              'Dir_Request_Status 14=Remote Request Loaded
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("Company")
    Call eChild.setAttribute("ID", IdxVars.Tracking.ComId)
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("BusinessUnit")
    Call eChild.setAttribute("ID", IdxVars.Tracking.BuId)
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("Message")
    'barb this must get the KTMessage Id
    If GetNextKtMessageId(strNewKtMsgId) Then
        Call eChild.setAttribute("ID", strNewKtMsgId)
    Else
        Call eChild.setAttribute("ID", IdxVars.Tracking.MsgId)
    End If
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("Reference")
    Call eChild.setAttribute("ID", IdxVars.Tracking.ReferenceId)
    Call eParent.appendChild(eChild)
    Set eChild = xmldoc.createElement("KeytaxRequestNumber")
    'barb: start here - put req seq num in file approve
    'here and insert into interface table
    eChild.Text = IdxVars.Tracking.ReqSeqNum
    Call eParent.appendChild(eChild)
     
    'MsgBox xmldoc.xml
    
    CreateXmlHeader = CStr(xmldoc.xml)
    
    Exit Function
    
WriteXmlStringFix:
    WriteToErr "WriteXmlString: " & Err.Number & " - " & Err.Description
End Function

Public Function InsertIntoInterfaceIndex(lngNewIntNo As Long, strNewMsgId As String) As Boolean

     'Db vars
    Dim strSql As String
    Dim cmdAdo As ADODB.Command
    Dim lngRecordsAffected As Long
    Dim rsIndex As ADODB.Recordset
    
    'barb: start here

    On Error GoTo InsertIntoInterfaceIndexFix
     
        If Not GetNextKtMessageId(strNewMsgId) Then
            InsertIntoInterfaceIndex = False
            Exit Function
        End If
     
        strSql = "Insert into DIR_INTERFACE_INDEX"
        strSql = strSql & " ("
        strSql = strSql & " COM_ID,"
        strSql = strSql & " BU_ID,"
        strSql = strSql & " MESSAGE_ID,"
        If IdxVars.Tracking.ReferenceId <> "NULL" Then
            If IdxVars.Tracking.ReferenceId <> "" Then
                strSql = strSql & " REFERENCE_ID,"
            End If
        End If
        If IdxVars.Tracking.ReqSeqNum <> "NULL" Then
            If IdxVars.Tracking.ReqSeqNum <> "" Then
                strSql = strSql & " REQ_SEQ_NUM,"
            End If
        End If
        strSql = strSql & " CREATED_DATE,"
        If IdxVars.SarsResponseYn <> "NULL" Then
            If IdxVars.SarsResponseYn <> "" Then
                strSql = strSql & " SARS_RESPONSE_YN,"
            End If
        End If
        If IdxVars.KeyTaxType <> "NULL" Then
            If IdxVars.KeyTaxType <> "" Then
                strSql = strSql & " KEYTAX_TYPE,"
            End If
        End If
        strSql = strSql & " MQ_STATUS)"
        strSql = strSql & " Values("
        strSql = strSql & "'" & IdxVars.Tracking.ComId & "',"
        strSql = strSql & "'" & IdxVars.Tracking.BuId & "',"
        'strSql = strSql & "'" & IdxVars.Tracking.MsgId & "',"
        strSql = strSql & "'" & strNewMsgId & "',"
        If IdxVars.Tracking.ReferenceId <> "NULL" Then
            If IdxVars.Tracking.ReferenceId <> "" Then
                strSql = strSql & "'" & IdxVars.Tracking.ReferenceId & "',"
            End If
        End If
        If IdxVars.Tracking.ReqSeqNum <> "NULL" Then
            If IdxVars.Tracking.ReqSeqNum <> "" Then
                strSql = strSql & "'" & IdxVars.Tracking.ReqSeqNum & "',"
            End If
        End If
        strSql = strSql & "GETDATE(),"
        If IdxVars.SarsResponseYn <> "NULL" Then
            If IdxVars.SarsResponseYn <> "" Then
                strSql = strSql & "'" & IdxVars.SarsResponseYn & "',"
            End If
        End If
        If IdxVars.KeyTaxType <> "NULL" Then
            If IdxVars.KeyTaxType <> "" Then
                strSql = strSql & "'" & IdxVars.KeyTaxType & "',"   'XML_TYPE: 06=File Approved Response
            End If
        End If
        strSql = strSql & "'00')"           'MQ_STATUS = "00" so that MQ program knows to pick it up.
        
        'barb: start here
                
        Set cmdAdo = New ADODB.Command
        With cmdAdo
            .CommandText = strSql
            .CommandType = adCmdText
            Set .ActiveConnection = adoConn
            .Execute lngRecordsAffected
        End With
        If lngRecordsAffected = 1 Then
            'get new interface no
            strSql = "Select INTERFACE_NO from DIR_INTERFACE_INDEX where MESSAGE_ID = '" & strNewMsgId & "'"
            Set rsIndex = adoConn.Execute(strSql)
            If rsIndex.RecordCount = 1 Then
                lngNewIntNo = rsIndex!INTERFACE_NO
                InsertIntoInterfaceIndex = True
            Else
                InsertIntoInterfaceIndex = False
            End If
        Else
            InsertIntoInterfaceIndex = False
        End If
        
        Exit Function
        
InsertIntoInterfaceIndexFix:
    InsertIntoInterfaceIndex = False
    WriteToErr "InsertIntoInterfaceIndex: " & Err.Number & " - " & Err.Description
End Function
Public Function InsertIntoInterfaceXml(lngNewIntNo As Long, strMsgId As String, strVersion As String, strDetail As String) As Boolean

      'Db vars
    Dim strSql As String
    Dim cmdAdo As ADODB.Command
    Dim lngRecordsAffected As Long

    Dim strCompleteXml As String
    Dim xmldoc As MSXML2.DOMDocument
    Dim strErrMsg As String
    
    'strCompleteXml = strVersion & strDetail
    strCompleteXml = strDetail

    'check that file conforms with DTD
    Set xmldoc = New MSXML2.DOMDocument
    
    'Validation XML Document
    'i.e. load the source XML file into an MSXML DOMDocument object
    xmldoc.async = False
    'If Not XMLDoc.Load("C:\Projects\KeyTax\Xml\XmlDocs\FormB_Request.xml") Then
    If Not xmldoc.loadXML(strCompleteXml) Then
        xmldoc.validateOnParse = True
        strErrMsg = strErrMsg & "Error Code:" & xmldoc.parseError.errorCode & vbCrLf
        strErrMsg = strErrMsg & "Error Reason:" & xmldoc.parseError.reason & vbCrLf
        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.srcText & vbCrLf
        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.Line & vbCrLf
        
        MsgBox "InsertIntoInterfaceXml: Xml does not conform to DTD" & vbCrLf & strErrMsg
        InsertIntoInterfaceXml = False
        Exit Function
    End If
    

    On Error GoTo InsertIntoInterfaceXmlFix
     
        strSql = "Insert into DIR_INTERFACE_XML"
        strSql = strSql & " ("
        strSql = strSql & " INTERFACE_NO,"
        strSql = strSql & " MESSAGE_ID,"
        strSql = strSql & " XML_STRING)"
        strSql = strSql & " Values("
        'get new no
        strSql = strSql & "'" & lngNewIntNo & "',"
        strSql = strSql & "'" & strMsgId & "',"
        strSql = strSql & "'" & strCompleteXml & "')"
                
        Set cmdAdo = New ADODB.Command
        With cmdAdo
            .CommandText = strSql
            .CommandType = adCmdText
            Set .ActiveConnection = adoConn
            .Execute lngRecordsAffected
        End With
        If lngRecordsAffected = 1 Then
            InsertIntoInterfaceXml = True
        Else
            InsertIntoInterfaceXml = False
        End If
        
        Exit Function
        
InsertIntoInterfaceXmlFix:
    InsertIntoInterfaceXml = False
    WriteToErr "InsertIntoInterfaceXml: " & Err.Number & " - " & Err.Description
End Function
Public Function GetNextKtMessageId(strNextVal As String) As Boolean

    Dim rsSeq As ADODB.Recordset
    Dim strSql As String
    Dim cmdAdo As ADODB.Command
    Dim lngRecordsAffected As Long
    Dim strFillString As String
    Dim strSeqNo As String
    
    On Error GoTo GetNextKtMessageIdFix
    
    
    'initilize the recordset
    Set rsSeq = New ADODB.Recordset
    rsSeq.CursorType = adOpenKeyset
    rsSeq.LockType = adLockOptimistic
    
    strSql = strSql & "Select LAST_VALUE from DIR_SEQUENCES where SEQ_NAME = 'DIR_KT_MSG_ID'"
    Set rsSeq = adoConn.Execute(strSql)
    If rsSeq.RecordCount > 0 Then
        strSeqNo = rsSeq!LAST_VALUE
        
        If Not IsNull(rsSeq!LAST_VALUE) Then
            If rsSeq!LAST_VALUE = "999999" Then
                strNextVal = "000001"
            ElseIf rsSeq!LAST_VALUE = "" Then
                MsgBox "DIR_KT_MSG_ID not set up in DIR_SEQUENCES"
                GetNextKtMessageId = False
            Else
                If strSeqNo = 0 Then
                    strSeqNo = 1
                Else
                    strSeqNo = strSeqNo + 1
                End If
                strFillString = String(6, "0")
                strNextVal = Format(CStr(strSeqNo), strFillString)
                
                strSql = "Update DIR_SEQUENCES set LAST_VALUE = " & CLng(strNextVal) & " where SEQ_NAME = 'DIR_KT_MSG_ID'"
                Set cmdAdo = New ADODB.Command
                With cmdAdo
                    .CommandText = strSql
                    .CommandType = adCmdText
                    Set .ActiveConnection = adoConn
                    .Execute lngRecordsAffected
                End With
                If lngRecordsAffected = 1 Then
                    GetNextKtMessageId = True
                Else
                    MsgBox "Couldn't update DIR_KT_MSG_ID not set up in DIR_SEQUENCES"
                    GetNextKtMessageId = False
                End If
                
            End If
        Else
            strNextVal = "000001"
        End If
    Else
        strNextVal = "000001"
    End If
                
    strNextVal = "KT" & strNextVal
    
        
        
'    Else
'
'    End If

    
    
    Exit Function
    
GetNextKtMessageIdFix:
    GetNextKtMessageId = False
    WriteToErr "GetNextKtMessageId: " & Err.Number & " - " & Err.Description
End Function
